The PC-SIG Library 10/The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso/PC_SIGCD/03/5/DISK0353.ZIP/MAKAMOVI.PAS

Pascal/Delphi Source File | 1984-09-15 | 26KB | 833 lines

{ (c) 1984 by Neil J. Rubenking }
program MakeAMovie;
type
  ScreenLoc = record
                character : char;
                attribute : byte;
              end;
  DefinedLoc  = record
                data : ScreenLoc;
                c,r  : byte;
              end;
  OneLine   = array[1..80] of ScreenLoc;
  Screen    = array[1..25] of OneLine;
  ScreenSet = ^node;
  node      = record
                AScreen : Screen;
                next    : ScreenSet;
              end;
  DiffFil  = file of DefinedLoc;
  FileNameType = string[14];
var
  ScreenSeg, wait          : integer;
  ScreenItself             : Screen absolute $B000:$0000;
  ColorScreen              : Screen absolute $B800:$0000;
  TempScreen, MenuScreen,
  LastScreen               : Screen;
  Screens, Pointer, temp,
  EndPointer               : ScreenSet;
  ScreenNum                : byte;
  col, row, N, P           : byte;
  DiffFile                 : DiffFil;
  filename                 : FileNameType;
  exists, color, First,OK  : boolean;
  choice, EscChoice        : char;
  BlankLine,  HighLine     : OneLine;
  EndLoc                   : DefinedLoc;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure twitter(note:integer);
var
  N : byte;
begin
  for N := 1 to 10 do
    begin
      sound(note);
      delay(50);
      sound(note*2);
      delay(50);
    end;
  nosound;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure GetKeys(var C, D:char);
begin
  D := chr(0);
  repeat until keypressed;
  read(Kbd,C);
  if keypressed then read(Kbd,D);
end;
{============================================================================}
function ReadScreen(col,row:byte):char;
var
  LocationCode : integer;
  begin
    LocationCode := (col-1)*2 + (row-1)*160;
    ReadScreen   := chr(Mem[ScreenSeg:LocationCode]);
  end;
{============================================================================}
procedure WriteScrn(col, row: byte; thisChar:char);
var
  LocationCode : integer;
begin
  LocationCode := (col-1)*2 + (row-1)*160;
  Mem[ScreenSeg:locationCode] := ord(ThisChar);
end;
{============================================================================}
procedure ScreenAttribute(col, row, attribute: byte);
var
  LocationCode : integer;
begin
  LocationCode := (col-1)*2+1 + (row-1)*160;
  Mem[ScreenSeg:locationCode] := attribute;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure MakeScreen; forward;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure ReverseOn;
begin
  TextColor(lightBlue);
  TextBackground(white);
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure ReverseOff;
begin
  TextColor(white);
  TextBackground(black);
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure AttemptReset(var ThisFile : DiffFil);
begin
  {$I-}
  reset(ThisFile);
  {$I+}
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
function different(var C,D:screenLoc):boolean;
begin
  different := (C.character <> D.character) or
               (C.attribute <> D.attribute);
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure ShowLocation;
var
  SaveX,SaveY : byte;
begin
  WriteScrn(54,1,chr((WhereX div 10)+48));
  WriteScrn(55,1,chr((WhereX mod 10)+48));
  WriteScrn(61,1,chr((WhereY div 10)+48));
  WriteScrn(62,1,chr((WhereY mod 10)+48));
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure DisposeAll(var List:ScreenSet);
begin
  if List <> nil then
    begin
      DisposeAll(list^.next);
      Dispose(list);
    end;
  List := nil;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure EditAScreen(operation : char);
var
  last : boolean;
  TheWord : string[12];
  count   : byte;
  {========================================================================}
   procedure ShowIt;
     begin
       ScreenItself := Pointer^.AScreen;
       ColorScreen  := Pointer^.AScreen;
       ScreenItself[1] := HighLine;
       ColorScreen[1]  := HighLine;
       GotoXY(1,1);
       ReverseOn;
       Write('Press ',chr(26),' to page thru , <return> to select,');
       Write(' <Esc> to exit.      Screen # ',count);
       ReverseOff;
     end;
  {========================================================================}
begin
  case operation of
    'e': TheWord := 'edit';
    'r': TheWord := 'remove';
    'i': TheWord := 'insert';
  end;
  ClrScr;
  GotoXY(10,18);
  Write('Page through the screens by pressing the right arrow key.');
  GotoXY(10,19);
  Write('When you get to the one');
  if operation = 'i' then write(' after which');
  Write(' you want to ',TheWord,' press <return>.');
  GotoXY(10,20);
  Write('To quit without ',Theword,'ing, press <Esc> or page past the end.');
  GotoXY(10,21);
  Write('Now press a key . . .');
  repeat until keypressed;
  Pointer := Screens;
  last    := False;
  ShowIt;
  count := 1;
  repeat
    GetKeys(choice,EscChoice);
      if (choice = chr(27)) and (EscChoice = 'M') then
        begin
          Pointer := Pointer^.next;
          count := count + 1;
          if Pointer <> nil then ShowIt else
            begin
              last := true;
              count := 0;
            end;
        end;
      if (choice = chr(13)) and (not last) then
        begin
          case operation of
            'e': begin
                   MakeScreen;
                   tempScreen[1] := BlankLine;
                   Pointer^.AScreen := tempScreen;
                   last := true;
                 end;
            'r': begin
                   if Pointer^.next = nil then Pointer := nil
                   else
                     begin
                       Pointer^.AScreen := Pointer^.next^.AScreen;
                       Pointer^.next    := Pointer^.next^.next;
                     end;
                   last := true;
                   ScreenNum := ScreenNum - 1;
                 end;
            'i': begin
                   MakeScreen;
                   TempScreen[1] := BlankLine;
                   new(temp);
                   temp^.AScreen := tempScreen;
                   temp^.next := Pointer^.next;
                   Pointer^.next := temp;
                   last := true;
                   ScreenNum := ScreenNum + 1;
                   count := count + 1;
                 end;
          end;  {case}
        end;   {if <return> pressed}
  until ((choice = chr(27)) and (EscChoice = chr(0))) or last;
  if count > 0 then
    begin
      ScreenItself[1] := HighLine;
      ColorScreen [1] := HighLine;
      GotoXY(1,1);
      Write('Screen #',count,' has been ',Theword,'ed.');
      twitter(500);twitter(1000);
    end;
  ScreenItself := MenuScreen;
  ColorScreen  := MenuScreen;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure SaveAllScreens;
var
  LastScreen : Screen;
  tempo      : DefinedLoc;
  {===============================================}
  procedure DiffWrite(var A,B:screen);
  begin
    for row := 1 to 25 do
      begin
        for col := 1 to 80 do
          begin
            if different(A[row][col],B[row][col]) then
              begin
                with tempo do
                  begin
                    data := A[row][col];
                    r    := row;
                    c    := col;
                  end;
                write(DiffFile,tempo);
              end;
          end;
      end;
    write(DiffFile,EndLoc);
  end;
  {===============================================}
  procedure DoWrite(var list:ScreenSet);
  begin
    while list <> nil do
      begin
        DiffWrite(list^.AScreen, LastScreen);
        LastScreen := list^.AScreen;
        list := list^.next;
      end;
  end;
  {===============================================}
  begin
    for row := 1 to 25 do
      for col := 1 to 80 do
        with LastScreen[row][col] do
          begin
            character := ' ';
            attribute := 15;
          end;
    ClrScr;
    GotoXY(20,20);
    Write('Name of Screen file? (omit extension!) ');
    read(fileName);
    P := pos('.',filename);
    if P <> 0 then delete(filename,P,length(filename)-P+1);
    filename := filename + '.scn';
    Assign(DiffFile,filename);
    WriteLn;
    exists := false;
    AttemptReset(DiffFile);
    exists := (IOResult = 0);
    if exists then
      begin
        choice := 'N';
        Write(filename,' already exists.  OverWrite? ');
        read(choice);
      end;
    if (not exists) or (UpCase(choice) = 'Y') then
      begin
        ReWrite(DiffFile);
        Pointer := Screens;
        DoWrite(Pointer);
      end;
    close(DiffFile);
  end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure AddScreen(ScreenToAdd:Screen);
begin
  ScreentoAdd[1] := BlankLine;
  if First then
    begin
      new(Screens);
      Screens^.AScreen := ScreenToAdd;
      Screens^.next    := nil;
      EndPointer       := Screens;
      ScreenNum        := 1;
      First            := false;
    end
  else
    begin
      new(EndPointer^.next);
      EndPointer := EndPointer^.next;
      EndPointer^.AScreen := ScreenToAdd;
      EndPointer^.next    := nil;
      ScreenNum     := ScreenNum + 1;
    end;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure ReadScreenFile(TheName:FileNameType);
var
  diff : DefinedLoc;
begin
  for row := 1 to 25 do
    for col := 1 to 80 do
      with LastScreen[row][col] do
        begin
          character := ' ';
          attribute := 15;
        end;
  Assign(DiffFile,TheName);
  WriteLn;
  AttemptReset(DiffFile);
  if (IOResult = 0) and (FileSize(DiffFile) > 0) then
    begin
      ScreenNum := 0;
      First     := true;
      DisposeAll(Screens);
      While not EOF(DiffFile) do
        begin
          read(DiffFile,diff);
          if different(diff.data,EndLoc.data) then
            LastScreen[diff.r][diff.c] := diff.data
          else
            AddScreen(LastScreen);
        end;  {while}
    end   {if}
  else
    OK := false;
  close(DiffFile);
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure GetReadyScreenFile;
  begin
    ClrScr;
    GotoXY(20,20);
    Write('Name of Screen file? (omit extension!) ');
    read(fileName);
    WriteLn;
    P := pos('.',filename);
    if P <> 0 then delete(filename,P,length(filename)-P+1);
    filename := filename + '.scn';
    OK := true;
    ReadScreenFile(filename);
    if not OK then write('Not found.');
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure MakeScreen;
var
  choice1, EscChoice : char;
  SaveX, SaveY       : byte;
  {================================================}
   procedure GoUp;
     begin
       if WhereY > 2 then GotoXY(WhereX,WhereY-1);
     end;
  {================================================}
   procedure GoDown;
     begin
       if WhereY < 25 then GotoXY(WhereX,WhereY+1);
     end;
  {================================================}
   procedure GoLeft;
     begin
       if WhereX > 1 then GotoXY(WhereX-1,WhereY);
     end;
  {================================================}
   procedure GoRight;
     begin
       if WhereX < 80 then GotoXY(WhereX+1,WhereY);
     end;
  {================================================}
   procedure LineDraw;
   var
     LastDir, ThisDir  : char;
     choice1,EscChoice : char;
     nups,ndowns,nlefts,nrights,allchars : set of char;
     ups,downs,lefts,rights : set of char;
     draw  : boolean;
     {----------------------------------------------------}
     function RightChar(ThisDir,LastDir:char):char;
     var
       temp : char;
       {- - - - - - - - - - - - - - - - - - - - - - - - -}
        function combine(A,B:char):char;
        var
          tempset : set of char;
          temp, C    : char;
        begin
          if A = B then temp := A
            else if A = ' ' then temp := B
            else
              begin
                tempset := allchars;
                if (A in ups) or (B in ups) then
                  tempset := tempset - nups;
                if (A in Nups) and (B in Nups) then
                  tempset := tempset - ups;
                if (A in downs) or (B in downs) then
                  tempset := tempset - ndowns;
                if (A in Ndowns) and (B in Ndowns) then
                  tempset := tempset - downs;
                if (A in lefts) or (B in lefts) then
                  tempset := tempset - nlefts;
                if (A in Nlefts) and (B in Nlefts) then
                  tempset := tempset - lefts;
                if (A in rights) or (B in rights) then
                  tempset := tempset - nrights;
                if (A in Nrights) and (B in Nrights) then
                  tempset := tempset - rights;
                for C := '╣' to '╬' do if C in tempset then temp := C;
              end;
          combine := temp;
        end;
       {- - - - - - - - - - - - - - - - - - - - - - - - -}
     begin
       case LastDir of
         'H': case ThisDir of
                'H': temp := '║';
                'K': temp := '╗';
                'M': temp := '╔';
                'P': temp := ' ';
              end;
         'K': case ThisDir of
                'H': temp := '╚';
                'K': temp := '═';
                'M': temp := ' ';
                'P': temp := '╔';
              end;
         'M': case ThisDir of
                'H': temp := '╝';
                'K': temp := ' ';
                'M': temp := '═';
                'P': temp := '╗';
              end;
         'P': case ThisDir of
                'H': temp := ' ';
                'K': temp := '╝';
                'M': temp := '╚';
                'P': temp := '║';
              end;
       end;   {case}
       if ReadScreen(WhereX,WhereY) in AllChars then
         RightChar := Combine(temp,ReadScreen(WhereX,WhereY))
       else RightChar := temp;
    end;
     {----------------------------------------------------}
   begin
     AllChars := ['╣','║','╗','╝','╚','╔','╩','╦','╠','═','╬'];
     nups    := ['╗','╔','╦','═'];
     ndowns  := ['╝','╚','╩','═'];
     nlefts  := ['║','╚','╔','╠'];
     nrights := ['╣','║','╗','╝'];
     ups     := AllChars - nups;
     downs   := AllChars - ndowns;
     rights  := AllChars - nrights;
     lefts   := Allchars - nlefts;
     draw    := false;
     ReverseOn;
     SaveX := WhereX; SaveY := WhereY;
     GotoXY(1,1);
     Write('[Esc] = back to plain draw   F2 toggles line     col    row');
     GotoXY(SaveX,SaveY);
     ReverseOff;
     ShowLocation;
     LastDir := '<';
     repeat
       GetKeys(choice1,EscChoice);
       if EscChoice in ['H','K','M','P','<','ä','s','t','u','v','w'] then
         begin
           if EscChoice = '<' then draw := not(draw);
           if draw then WriteScrn(WhereX,WhereY,RightChar(EscChoice,LastDir));
           LastDir := EscChoice;
           case EscChoice of
             'H': GoUp;     'ä': if not draw then GotoXY(WhereX,2);
             'K': GoLeft;   's': if not draw then GotoXY(1,WhereY);
             'M': GoRight;  't': if not draw then GotoXY(80,WhereY);
             'P': GoDown;   'v': if not draw then GotoXY(WhereX,25);
                            'w': if not draw then GotoXY(1,2);
                            'u': if not draw then GotoXY(80,25);
           end;
           ShowLocation;
         end;
     until (choice1 = chr(27)) and (EscChoice = chr(0));
     ReverseOn;
     SaveX := WhereX;
     SaveY := WhereY;
     GotoXY(1,1);
     Write('F1 = block draw  F2 line draw                    col    row');
     ReverseOff;
     GotoXY(SaveX,SaveY);
   end;
  {================================================}
   procedure BlockDraw;
   var
     choice1,EscChoice : char;
     N,M : byte;
   {------------------------------------------------------------}
    procedure TEN(C:char);
    begin
      M := 80 - WhereX;
      if M > 10 then M := 10;
      if M > 0 then
        for N := 1 to M do write(C);
    end;
   {------------------------------------------------------------}
    procedure FIVE(C:char);
    begin
      M := 25 - WhereY;
      if M > 5 then M := 5;
      if M > 0 then for N := WhereY to WhereY + M do
        begin
          GotoXY(WhereX, N);
          write(C);write(chr(8));
        end;
    end;
   {------------------------------------------------------------}
   begin
     ColorScreen[1]  := HighLine;
     ScreenItself[1] := HighLine;
     ReverseOn;
     SaveX := WhereX;
     SaveY := WhereY;
     GotoXY(1,1);
     Write('F1░ F2▒ F3▓ F4█ F5▄ F6▀ F7▌ F8▐ F9■ F10{space}   col    row');
     ReverseOff;
     GotoXY(SaveX,SaveY);
     ShowLocation;
     repeat
       GetKeys(choice1,EscChoice);
       Case EscChoice of
         'G': begin GoUp;GoLeft;end;    ';': write('░'); 'T': TEN('░');
         'H': GoUp;                     '<': write('▒'); 'U': TEN('▒');
         'I': begin GoUp;GoRight;end;   '=': write('▓'); 'V': TEN('▓');
         'K': GoLeft;                   '>': write('█'); 'W': TEN('█');
         'M': GoRight;                  '?': write('▄'); 'X': TEN('▄');
         'O': begin GoDown;GoLeft;end;  '@': write('▀'); 'Y': TEN('▀');
         'P': GoDown;                   'A': write('▌'); 'Z': TEN('▌');
         'Q': begin;GoDown;GoRight;end; 'B': write('▐'); '[': TEN('▐');
         'ä': GotoXY(WhereX,2);         'C': write('■'); '/': TEN('■');
         's': GotoXY(1,WhereY);         'D': write(' '); ']': TEN(' ');
         't': GotoXY(80,WhereY);        'h': FIVE('░');  'm': FIVE('▀');
         'v': GotoXY(WhereX,25);        'i': FIVE('▒');  'n': FIVE('▌');
         'w': GotoXY(1,2);              'j': FIVE('▓');  'o': FIVE('▐');
         'u': GotoXY(80,25);            'k': FIVE('█');  'p': FIVE('■');
                                        'l': FIVE('▄');  'q': FIVE(' ');
       end;  {case}
       ShowLocation;
     until (choice1 = chr(27)) and (EscChoice = chr(0));
     ColorScreen[1]  := HighLine;
     ScreenItself[1] := HighLine;
     ReverseOn;
     SaveX := WhereX; SaveY := WhereY;
     GotoXY(1,1);
     Write('F1 = block draw  F2 line draw                    col    row');
     ReverseOff;
     GotoXY(SaveX,SaveY);
   end;
  {================================================}
begin
  ColorScreen[1]  := HighLine;
  ScreenItself[1] := HighLine;
  ReverseOn;
  GotoXY(1,1);
  Write('F1 = block draw  F2 line draw                    col    row');
  ReverseOff;
  GotoXY(40,20);
  ShowLocation;
  repeat
    GetKeys(choice1,EscChoice);
    Case EscChoice of
      'G': begin GoUp;GoLeft;end;     'w': GotoXY(1,2);
      'H': GoUp;
      'I': begin GoUp;GoRight;end;    'ä': GotoXY(WhereX,2);
      'K': GoLeft;                    's': GotoXY(1,WhereY);
      'M': GoRight;                   't': GotoXY(80,WhereY);
      'O': begin GoDown;GoLeft;end;   'u': GotoXY(80,25);
      'P': GoDown;
      'Q': begin;GoDown;GoRight;end;  'v': GotoXY(WhereX,25);
      ';': BlockDraw;
      '<': LineDraw;
      'C': begin; WriteScrn(WhereX,WhereY,chr(27)); GoRight; end;
      'D': begin; WriteScrn(WhereX,WhereY,chr(3)) ; GoRight; end;
    else
       case ord(choice1) of
         3:;{chr(3) = ^C, so this will not come up}
         8: begin; GoLeft; WriteScrn(WhereX,WhereY,' ');end;
        27:;{chr(27) = Esc, so entering it will exit draw mode}
       else
         WriteScrn(WhereX,WhereY,choice1);
         GoRight;
       end;  {inner case}
    end;  {case}
    ShowLocation;
  until (choice1 = chr(27)) and (EscChoice = chr(0));
  if color then tempScreen := ColorScreen
  else tempScreen := screenItself;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure SeeScreen;
var
  Number, count : byte;
begin
  ClrScr;
  GotoXY(20,20);
  number := ScreenNum;
  Write('There are ',ScreenNum,' screens.  Which #? ');
  GotoXY(20,21);
  write('(Just <enter> for latest screen)');
  read(Number);
  if (Number > 0) and (Number <= ScreenNum) then
    begin
      Pointer := Screens;
      count := 1;
      while count < Number do
        begin
          if Pointer^.next <> nil then Pointer := Pointer^.next;
          count := count + 1;
        end;
      ScreenItself := Pointer^.AScreen;
      ColorScreen  := Pointer^.AScreen;
    end
  else
    begin
      ScreenItself := TempScreen;
      ColorScreen  := TempScreen;
    end;
  MakeScreen;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure DoPlay(var list:ScreenSet;wait:integer);
begin
  ScreenItself := list^.AScreen;
  ColorScreen  := list^.AScreen;
  delay(wait);
  list := list^.next
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure PlayScreens;
begin
  GotoXY(32,20);
  Write('How much wait between? ');
  read(wait);
  Pointer := Screens;
  GotoXY(1,1);
  While Pointer <> nil do DoPlay(Pointer,wait);
  ColorScreen[1]  := HighLine;
  ScreenItself[1] := HighLine;
  ReverseOn;
  GotoXY(1,1);
  write('Press a key to continue . . .');
  repeat until keypressed;
  ReverseOff;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure CycleScreens;
begin
  GotoXY(32,22);
  Write('How much wait between? ');
  read(wait);
  GotoXY(1,1);
  repeat
    Pointer := Screens;
    While Pointer <> nil do DoPlay(Pointer,wait);
  until keypressed;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure FinishUp;
var
  choice : char;
begin
  if color then tempScreen := ColorScreen
  else TempScreen := ScreenItself;
  ClrScr;
  GotoXY(20,20);
  Write('Are you sure you want to quit? ');
  GotoXY(20,21);
  Write('If you didn`t save your work yet, just say "N".');
  repeat until keypressed;
  read(Kbd,choice);
  if UpCase(choice) = 'Y' then halt
    else
      begin
        ScreenItself := TempScreen;
        ColorScreen  := TempScreen;
      end;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure MakeMenuScreen;
var
  MenuLines : array[1..11] of string[40];
begin
  MenuLines[1] :=  'F1  CREATE a screen                     ';
  MenuLines[2] :=  'F2  ADD    a screen to the list         ';
  MenuLines[3] :=  'F3  REMOVE a screen from the list       ';
  MenuLines[4] :=  'F4  INSERT a screen into the list       ';
  MenuLines[5] :=  'F5  EDIT   any screen in the list       ';
  MenuLines[6] :=  'F6  RE-USE a screen                     ';
  MenuLines[7] :=  'F7  WRITE  the list to a file           ';
  MenuLines[8] :=  'F8  READ   a file into a new list       ';
  MenuLines[9] :=  'F9  PLAY   the current list             ';
  MenuLines[10] := 'F10 CYCLE  thru current screens         ';
  MenuLines[11] := 'ESCAPE always gets you out!             ';
for row := 1 to 25 do MenuScreen[row] := BlankLine;
for row := 1 to 11 do
  begin
    for col := 21 to 60 do
      begin
        MenuScreen[2*row+2][col].character := MenuLines[row][col-20];
        if (col in [21,22,25..30]) and (row < 11)
        then MenuScreen[2*row+2][col].attribute := 112
          else MenuScreen[2*row+2][col].attribute := 15;
      end;
  end;
  MenuScreen[22][23].attribute := 112;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure MainMenu;
var
  filler, choice : char;
begin
  ScreenItself := MenuScreen;
  ColorScreen  := MenuScreen;
  repeat
    GetKeys(filler,choice);
    if (filler = chr(27)) and (choice = chr(0)) then FinishUp;
  until choice in [';','<','=','>','?','@','A','B','C','D'];
  case choice of
    ';': begin
           ClrScr;
           MakeScreen;
         end;
    '<': begin
           AddScreen(tempScreen);
           GotoXY(25,6);
           Write('ADDed screen # ',ScreenNum,'.                  ');
           twitter(500);
         end;
    '=': EditAScreen('r');
    '>': EditAScreen('i');
    '?': EditAScreen('e');
    '@': SeeScreen;
    'A': SaveAllScreens;
    'B': GetReadyScreenFile;
    'C': PlayScreens;
    'D': CycleScreens;
  end;
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure initialize;
begin
  First := true;
  if (Mem[0000:1040] and 48) <> 48 then
    begin
      ScreenSeg := $B800;
      color     := true;
    end
  else
    begin
      ScreenSeg := $B000;
      color     := false;
    end;
  ScreenNum := 0;
  Screens := nil;
  for N := 1 to 80 do
    begin
      BlankLine[N].character := ' ';
      BlankLine[N].attribute := 15;
      HighLine[N].character := ' ';
      HighLine[N].attribute := 9;
    end;
  MakeMenuScreen;
  with EndLoc do
    begin
      data.character := chr(0);
      data.attribute := 0;
      r := 0; c := 0;
    end;
  filename := '';
end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
procedure IntroMovie;
begin
  OK := true;
  filename := 'intro.scn';
  ReadScreenFile(filename);
  if OK then
    begin
      Twitter(500);Twitter(1000);Twitter(1500);
      Pointer := Screens;
      wait := 50;
      While Pointer <> nil do DoPlay(Pointer,wait);
      ColorScreen[1]  := HighLine;
      ScreenItself[1] := HighLine;
      ReverseOn;
      GotoXY(1,1);
      write('Press a key to continue . . .');
      repeat until keypressed;
      ReverseOff;
      DisposeAll(Screens);
      ScreenNum := 0;
      First := true;
    end;
 end;
{≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
begin
  initialize;
  IntroMovie;
  repeat MainMenu until false;
  ClrScr;
end.